home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / LUBKSB.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  875b  |  36 lines
  1. PROCEDURE lubksb(a: glnpbynp; n,np: integer; indx: glindx; VAR b: glnarray);
  2. (* Programs using LUBKSB must define the types
  3. TYPE
  4.    glnarray = ARRAY [1..n] OF real;
  5.    glindx = ARRAY [1..n] OF integer;
  6.    glnpbynp = ARRAY [1..np,1..np] OF real;
  7. in the main routine *)
  8. VAR
  9.    j,ip,ii,i: integer;
  10.    sum: real;
  11. BEGIN
  12.    ii := 0;
  13.    FOR i := 1 TO n DO BEGIN
  14.       ip := indx[i];
  15.       sum := b[ip];
  16.       b[ip] := b[i];
  17.       IF  (ii <> 0) THEN BEGIN
  18.          FOR j := ii TO i-1 DO BEGIN
  19.             sum := sum-a[i,j]*b[j]
  20.          END
  21.       END ELSE IF (sum <> 0.0) THEN BEGIN
  22.          ii := i
  23.       END;
  24.       b[i] := sum
  25.    END;
  26.    FOR i := n DOWNTO 1 DO BEGIN
  27.       sum := b[i];
  28.       IF (i < n) THEN BEGIN
  29.          FOR j := i+1 TO n DO BEGIN
  30.             sum := sum-a[i,j]*b[j]
  31.          END
  32.       END;
  33.       b[i] := sum/a[i,i]
  34.    END
  35. END;
  36.